home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / savage.zip / TIMERD12.INC < prev   
Text File  |  1987-01-30  |  3KB  |  87 lines
  1. { Timerd12.inc - DOS event timer                            ver 1.2, 01-30-87 }
  2. {   by Jim H. LeMay  CIS: 76011,217                                           }
  3. { A 24 hour timer with resolution of 1/18.2... seconds to measure elapsed time
  4.   in seconds.  Works on all IBM compatible machines and is interchangeable with
  5.   TIMERH.INC.  If TIMERH.INC can work on your machine, then use it; if not,
  6.   TIMERD.INC will.  Both also compile with Turbo87.
  7.   TO TEST: Remove the curly braces around "BEGIN ... END".  Compile and Run.
  8.   TO USE:  Place "Timer(Start)" and "Timer(Stop)" as desired in your program.
  9.            "ElapsedTime" gives result in seconds.  }
  10.  
  11. type
  12.     StartStop = (Start, Stop, SetRead, ReadRead);
  13.     TicksArray = array [1..5] of byte;
  14. var
  15.     t0,t1,t2,TicksPerDay,TicksPerSec,ElapsedTime: real;
  16.     T1array,T2array: TicksArray;
  17. const
  18.     FirstTime: boolean = true;
  19.  
  20. procedure GetTicks (VAR Ticks: TicksArray);
  21. begin
  22. Inline(
  23.   $1E                    {   push  ds               ;Save Turbo DS}
  24.   /$31/$C0               {   xor   ax,ax            ;Set ax=0}
  25.   /$8E/$D8               {   mov   ds,ax            ;Segment for DOS timer}
  26.   /$BE/$6C/$04           {   mov   si,$046C         ;Offset for DOS timer}
  27.   /$C4/$7E/<TICKS        {   les di,[bp+<Ticks]     ;Load address of split}
  28.   /$FC                   {   cld                    ;Set direction forward}
  29.   /$AB                   {   stosw                  ;Store zero}
  30.   /$FA                   {   cli                    ;Clear interrupts}
  31.   /$A4                   {   movsb                  ;Copy DOS low byte}
  32.   /$A5                   {   movsw                  ;Copy DOS mid word}
  33.   /$FB                   {   sti                    ;Allow interrupts}
  34.   /$1F                   {   pop   ds               ;Restore Turbo DS}
  35. )
  36. end;
  37.  
  38. function ArrayToReal (Ticks: TicksArray): real;
  39. begin
  40.   ArrayToReal := ((Ticks[5]*256.0) + Ticks[4])*256 + Ticks[3]
  41. end;
  42.  
  43. procedure TimerInit;
  44. begin
  45.   FirstTime := false;
  46.   TicksPerDay := 1573040.0;             { DOS timer ticks/day. }
  47.   TicksPerSec := TicksPerDay/86400.0;
  48.   t0 := 0.0                             { only needed for TIMERH.INC }
  49. end;
  50.  
  51. procedure Timer (SS: StartStop);
  52. begin
  53. case SS of
  54.   Start: begin
  55.            if FirstTime then TimerInit;
  56.            ElapsedTime:=0;
  57.            GetTicks (T1array)
  58.          end;
  59.   Stop:  begin
  60.            GetTicks (T2array);
  61.            t1 := ArrayToReal(T1array);           { Convert AFTER the event! }
  62.            t2 := ArrayToReal(T2array);
  63.            if t2<t1 then t2:=t2+TicksPerDay;
  64.            ElapsedTime:= (t2-t1)/TicksPerSec     { units of seconds }
  65.          end
  66.   end   { end case }
  67. end;
  68.  
  69. {
  70. var ch: char;
  71.  
  72. BEGIN
  73.   ClrScr;
  74.   Writeln('Press any key for a lap; <ESC> to stop.');
  75.   Timer (Start);
  76.   repeat
  77.     write(chr(16));
  78.     read(Kbd,ch);
  79.     Timer (Stop);
  80.     writeln ('E.T. =',ElapsedTime:10:2,' secs: ticks2=',t2:12:0);
  81.     GotoXY (24,wherey); WriteLn ('-ticks1=',t1:12:0);
  82.     GotoXY (21,wherey); WriteLn ('E.T. ticks=',(t2-t1):12:0);
  83.     writeln;
  84.   until ch = chr(27)
  85. END.
  86. }
  87.